سفارشی سازی مسیج باکس ها به کمک برنامه نویسی VBA
سلام به یکی دیگر از آموزش ها ما در سایت سافت پلاس خوش آمدید . امروز در این مطلب می خواهیم با هم به یک آموزش جالب و کاربردی بپردازیم تحت عنوان سفارشی سازی مسیج باکس ها.
در برنامه نویسی VBA ما یک تابعی داریم به اسم MsgBox . این تابع یک تابع بسیار مهم و کاربردی در برنامه نویسی وی بی ای است که خیلی جاها از آن استفاده می کنیم .
خیلی از برنامه ها از جمله خود مفسر زبان VBA هم خیلی از پیغام های خود را در قالب مسیج باکس ها برای کاربر به نمایش می گذارد .
پس مسیج باکس ها هم می توانند از طرف خود برنامه استفاده شوند و هم اینکه می توانیم ما آنها را ایجاد کنیم .
اینجا نمی خواهیم در مورد اینکه چه جوری یک مسیج باکس را ایجاد کنیم صحبتی کنیم . بلکه امروز می خواهیم کار متفاوتی را برای ایجاد مسیج باکس ها انجام دهیم .
اگر از ظاهر ثابت و یکنواخت کادرهای پیغام خود در همه حالت ها خسته شده اید ؟
اگر این سوال برای شما پیش آمده است که آیا می شود تغییراتی را در ساختار و شکل ظاهری کادرهای پیغام ایجاد کرد ؟
و اینکه اگر این کارها شدنی است چه جوری می شود این کار را انجام داد پس در جای درستی قرار گرفته اید و در حال مطالعه مطلب درستی هستید .
من علیرضا شهرآئینی هستم و در این آموزش به شما خواهم گفت که چطور می شود در ساختار و شکل ظاهری کادرهای پیغام خود تغییراتی را اعمال کنید کاری که مطمئنا برای شما هم جالب خواهد بود و هم کاربردی .
پس تا انتهای این مطلب من را همراهی کنید .
فهرست محتوا
مراحل انجام سفارشی سازی مسیج باکس ها
اول اجازه بدهید که توضیح بدهم که وقتی صحبت از سفارشی سازی مسیج باکس ها می کنیم منظورمان چیست و در یک کلام بگوییم که می خواهیم چکار کنیم .
در حالت عادی وقتی که ما یک مسیج باکس را ایجاد می کنیم یک سری از المان ها را در ساختار آنها استفاده می کنیم .
مثلا در ساختار آنها از دکمه ها استفاده می کنیم یا متن ها و نوشته هایی که در ساختار مسیج باکس ها هستند جزو بخش های مهم یک مسیج باکس هستند .
اما در این بین چیزی که وجود دارد در حالت عادی ما نمی توانیم هیچ کدام از این بخش ها را تغییر دهیم . مثلا اگر متن یک دکمه OK باشد ما نمی توانیم آن را به مقدار دیگری تغییر دهیم .
یا در مورد نوشته ها و متن های موجود در بدنه مسیج باکس ها در حالت عادی امکان تغییر رنگ آنها برای ما وجود ندارد .
امروز و در این آموزش دقیقا می خواهیم راجع به همین تغییرات با هم صحبت کنیم .
یعنی اینکه چه جوری می شود رنگ نوشته ها را تغییر دهیم و اینکه چه جوری رنگ متن ها را در تکس باکس های خود تغییر دهیم .
مسلما نیازی به گفتن این مطلب هم نیست که ما برای انجام این تغییرات تنها یک راه در پیش داریم و آن هم استفاده از کدهای VBA است . در ادامه با هم قدم به قدم پیش می رویم و این کدها را ایجاد می کنیم .
۱- تغییر رنگ نوشته های موجود در مسیج باکس
می دانیم رنگ نوشته های مربوط به مسیج باکس ها در همه حالات به رنگ مشکی می باشد .در اینجا می خواهیم بدانیم که چه جوری
می شود رنگ مورد نظر خود را برای این متن ها اختصاص دهیم .
برای این کار احتیاج به یک سری از کدها داریم . من این کدها را از با اندکی جستجو از اینترنت یافته ام و با کمی تغییرات از آنها در اینجا استفاده می کنم .
اول بیایید نگاهی به کدهای زیر بکنیم .
#If Win64 Then
_"Private Declare PtrSafe Function GetSysColor Lib "user32
(ByVal nIndex As Long) As Long
_"Private Declare PtrSafe Function SetSysColors Lib "user3
(ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
Else#
_"Private Declare Function GetSysColor Lib "user32
(ByVal nIndex As Long) As Long
_"Private Declare Function SetSysColors Lib "user32
(ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
#End If
اما این کدها چی هستند ؟
این کدها کدهایی هستند که از API ویندوز استفاده می کنند . حالا اینکه این API چی هستند خودش مطلب جدایی است . فقط همین قدر بدانید که با استفاده از این کدها به برخی توابع داخلی ویندوز دسترسی پیدا می کنیم .
این کدها قرار است هم برای ویندوز ۳۲ بیتی و هم ویندوز ۶۴ بیتی به راحتی کار کنند . این کدها را کپی کنید و در داخل یک ماژول ذخیره کنید .
حالا به سراغ کدهای دیگری می رویم .
به کدهای زیر نگاه کنید .
Public Sub MsgBoxColorDemo()
Dim defaultColour As Long
defaultColour = GetSysColor(COLOR_WINDOWTEXT)
SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed
MsgBox "اين متن به رنگ قرمز نمايش داده مي شود", vbCritical, "Your result is..."
SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, RGB(0, 128, 0)
MsgBox "اين متن به رنگ سبز نمايش داده مي شود ", , "سافت پلاس ..."
SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, defaultColour
End Sub
اینجا چه اتفاقی می افتد و این کدها چه کار می کنند؟ این کدها اول رنگ فونت پیش فرض متن های سیستم ما را در خود ذخیره می کند .
در قدم بعدی ابتدا یک مسیج باکس ایجاد می شود که رنگ نوشته های آن به رنگ قرمز در خواهد آمد .
در گام بعدی یک مسیج باکس دیگر ایجاد می شود که در آن رنگ نوشته ها به رنگ سبز خواهد بود .
بعد از انجام این تغییرات خط آخر از این کدها مجددا رنگ پیش فرض را به سیستم برمی گرداند.
بنابراین مشاهده می کنید که به راحتی با استفاده از این کدها می توانیم رنگ مورد نظر خود را در متن کادرهای پیغام تغییر دهیم .
درگام بعدی به سراغ این خواهیم رفت که چه جوری عنوان دکمه هایی را که بر روی مسیج باکس ما قرار دارد را تغییر داده و آنها را به صورت فارسی شده درآوریم .
حالا اینکه چطور می توانیم از این کدها استفاده کنیم را در قالب یک مثال عملی در ویدئوی ابتدای همین صفحه می توانید یاد بگیرید .
۲- تغییر عنوان دکمه ها در یک Message box
تابع Msgbox دارای یک سری از پارامترها می باشد یکی از این پارامترها مربوط به تعیین نوع دکمه هایی است که بر روی کادر پیغام برای کاربر نمایش داده می شوند .
مثلا به کد زیر توجه کنید .
MsgBox "آيا مي خواهيد ادامه دهيد؟ ", vbOKCancel
خروجی کدهای بالا کادر پیغامی خواهد بود مانند تصویر زیر .
تابع مسیج باکس بصورت پیش فرض دارای ۷ نوع مختلف از دکمه ها می باشد .ما می توانیم بنا به نیاز خود هر کدام از این دکمه ها را انتخاب و بر روی کادر پیغام خود نمایش دهیم .
اما در حالت معمولی ما نمی توانیم متنی را که بر روی هر کدام از این دکمه ها قرار دارند را تغییر دهیم . حالا کاری که قرار است بکنیم این است که عنوان موجود بر روی دو دکمه ای را که در تصویر بالا مشاهده می کنید را به عناوین فارسی تغییر دهیم .
برای این کار باز هم باید از برنامه نویسی وی بی ای کمک بگیریم .
برای شروع زیر کدهای زیر را نگاه کنید .
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
(ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
(ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As LongPtr) As Long
Private hHook As LongPtr
#Else
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private hHook As Long
#End If
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private sMsgBoxDefaultLabel(1 To 7) As String
Private sMsgBoxCustomLabel(1 To 7) As String
Private bMsgBoxCustomInit As Boolean
Private Sub MsgBoxCustom_Init()
Dim nID As Integer
Dim vA As Variant
vA = VBA.Array(vbNullString, "OK", "Cancel", "Abort", "Retry", "Ignore", "Yes", "No")
For nID = 1 To 7
sMsgBoxDefaultLabel(nID) = vA(nID)
sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID)
Next nID
bMsgBoxCustomInit = True
End Sub
Public Sub MsgBoxCustom_Set(ByVal nID As Integer, Optional ByVal vLabel As Variant)
If nID = 0 Then Call MsgBoxCustom_Init
If nID < 1 Or nID > 7 Then Exit Sub
If Not bMsgBoxCustomInit Then Call MsgBoxCustom_Init
If IsMissing(vLabel) Then
sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID)
Else
sMsgBoxCustomLabel(nID) = CStr(vLabel)
End If
End Sub
Public Sub MsgBoxCustom_Reset(ByVal nID As Integer)
Call MsgBoxCustom_Set(nID)
End Sub
#If VBA7 Then
Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Dim nID As Integer
If lMsg = HCBT_ACTIVATE And bMsgBoxCustomInit Then
For nID = 1 To 7
SetDlgItemText wParam, nID, sMsgBoxCustomLabel(nID)
Next nID
End If
MsgBoxCustom_Proc = CallNextHookEx(hHook, lMsg, wParam, lParam)
End Function
Public Sub MsgBoxCustom( _
ByRef vID As Variant, _
ByVal sPrompt As String, _
Optional ByVal vButtons As Variant = 0, _
Optional ByVal vTitle As Variant, _
Optional ByVal vHelpfile As Variant, _
Optional ByVal vContext As Variant = 0)
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxCustom_Proc, 0, GetCurrentThreadId)
If IsMissing(vHelpfile) And IsMissing(vTitle) Then
vID = MsgBox(sPrompt, vButtons)
ElseIf IsMissing(vHelpfile) Then
vID = MsgBox(sPrompt, vButtons, vTitle)
ElseIf IsMissing(vTitle) Then
vID = MsgBox(sPrompt, vButtons, , vHelpfile, vContext)
Else
vID = MsgBox(sPrompt, vButtons, vTitle, vHelpfile, vContext)
End If
If hHook <> 0 Then UnhookWindowsHookEx hHook
End Sub
اینکه این کدها چه کاری را انجام می دهند چیزی نیست که بخواهیم راجع به آنها در اینجا صحبت کنیم
داستان این کدها کمی طولانی است و ممکن است ما را از هدف خودمان دور کند .
فقط آن چیزی که برای ما مهم است کاری است که این کدها قرار است برای ما انجام دهند . ما با استفاده از کدها می توانیم عنوان دکمه های مورد نظر را بر روی دکمه های خود تغییر دهیم .
اما چطوری ؟
فرض کنید که ما در یک روال چندین خط از کدها را داریم . در بخشی از این روال هم یک مسیج باکس را ایجاد کرده ایم که قرار است پیغامی را به کاربر نمایش دهد .
اجازه دهید از اینجا به بعد را با هم بر روی یک پروژه خیلی کوچک کار کنیم . برای این کار به فرم زیر نگاه کنید .
من در این فرم دو تکست باکس دارم و از کاربر خود می خواهم که اطلاعات خواسته شده را در آنها وارد کند . سپس برای ثبت این اطلاعات کاربر بر روی دکمه ثبت کلیک می کند .
اما قبل از ثبت شدن اطلاعات یک کادر پیغام به کاربر نمایش داده می شود و از کاربر تائیدیه نهایی را می گیرد . اگر دقت کنید دکمه های موجود بر روی این مسیج باکس بصورت فارسی درج شده اند .
من برای ایجاد این پروژه کوچک کدهای زیر را در رویداد مربوط به On Click دکمه خود نوشته ام .
در انتها نتیجه کار شبیه تصویر زیر خواهد بود .
می بینید که با استفاده از قدرت و جادوی برنامه نویسی به راحتی توانستیم تغییرات مورد نظر خود را در زمینه سفارشی سازی مسیج باکس ها به سرانجام برسانیم .
در این مطلب ما دو کار را انجام دادیم هم موفق شدیم که رنگ نوشته ها و فونت های کادر های پیغام خود را تغییر دهیم و هم اینکه توانستیم دکمه های سفارشی را برای مسیج باکس خود ایجاد کنیم .
حالا می رسیم به انتهای این آموزش .امیدوارم که برایتان کاربردی و مفید واقع شده باشد .
از دوستانی که پرسش ؛ سوال یا ابهامی در مورد این مطلب دارند می توانند سوالات خود را در بخش نظرات درج کنند تا در اولین فرصت پاسخ داده شود .
چطور بود ؟ این آموزش برات کاربردی بود ؟
فکر می کنی چه چیز دیگه ای میشه به این آموزش اضافه کرد که اون رو تکمیل تر بکنه ؟
شما هم مثل بقیه هر نظر ، سوال یا پیشنهادی داری در قسمت دیدگاهها برام بنویس.
ممنون از همراهی شما .
برای مشاهده لینک دانلود لطفا وارد حساب کاربری خود شوید!
وارد شویدپسورد فایل : گزارش خرابی لینک
مطالب زیر را حتما مطالعه کنید
ذخیره نمودارها با کدهای VBAبصورت تصویر+راهنمای گام به گام
لیست باکس ها در برنامه نویسی VBA ؛ تمام چیزی که باید بدانید .
۷ اشتباه در کدنویسی VBA که ممکن است شما هم مرتکب شوید ؟
توی این آموزش راجع به اشتباهاتی که ممکن است در برنامه نویسی VBA مرتکب آنها شوید صحبت می کنیم .
با این خطای Runtime Error 1004 در VBA چکار کنیم ؟
در این آموزش راجع به خطایی به اسم Run time error 1004 در برنامه نویسی وی بی ای با هم صحبت می کنیم .
چطور با کدهای VBA اطلاعات را از اکسس به ورد بفرستیم؟
کلمه کلیدی set و کاربردهای آن در برنامه نویسی VBA
18 دیدگاه
به گفتگوی ما بپیوندید و دیدگاه خود را با ما در میان بگذارید.
سلام، وقت بخیر
باسلام
ممنون از مطالب خوب و کاربردی که برای دوستداران آفیس منتشر میکنید. خدا قوت
ممنون از اظهار لطف شما امیدوارم که همواره نظرات شما را در موارد مختلف در سایت مطالعه کنم
نمونه این مسیج ها رو برامن بفرستین هم رنگ وهم فارسی کردن باتن
لطفا
فایل اموزشی ونمونه رو برای من بفرستید
هرچی نوشتیم خبری از ارسال نمونه پروژه تون نشد که نشد
سلام به زودی نمونه فایل در سایت قرار خواهد گرفت
لطفا فایل نمونه را قرار دهید چون کدها ایراد دارند
بسیار بسیار عالی و کاربردی بود
ممنون میشم اگر فایل نمونه رو برام ارسال کنید
با احترام
سلام به زودی نمونه فایل قرار داده خواهد شد
ممنون میشم نمونه فایل رو برام ارسال کنید
سلام بزودی توی ادیت این مطلب نمونه فایل هم قرار میدم
عالی بود
سلام softpluse عزیز من نتونستم فایل نمونه را پیدا کنم ممنون میشم راهنمایی بفرمایید
سلام بزودی نمونه فایل قرار داده خواهد شد.
عالی بود
سلام میشه فایل رو برای من بفرستید
بزودی فایل نمونه در سایت قرار خواهد گرفت